home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
listing.arc
/
LISTING.BIX
Wrap
Text File
|
1980-01-06
|
7KB
|
317 lines
{ NAME: newprocess
EXAMPLE CALL:
p:=NewProcess(Ofs(proc),1000);
proc is the parameterless procedure, from which
the new process is created. The stack of the
new process p is 1000 bytes.
}
function NewProcess(prog: integer; size: integer): Process;
var stack: ^integer;
begin
GetMem(stack,size);
MemW[Seg(stack^):Ofs(stack^)+size-10]:=prog;
MemW[Seg(stack^):Ofs(stack^)+size-12]:=Ofs(stack^)+size-12;
NewProcess:=Ptr(Seg(stack^),Ofs(stack^)+size-12);
end;
[ Listing 1. ]
; procedure transfer(var p1,p2: Process);
;
cseg segment 'cgroup'
assume cs:cseg
transfer proc near
;
push bp ; Turbo Pascal generated prolog
mov bp,sp ; - - - -
;
pop bp ; Align with `newprocess' setup
les bp,dword ptr [bp]+4 ; get address of p2
mov ax,es:[bp]+2 ; get segment part of p2
mov bx,es:[bp] ; get offset part of p2
mov bp,sp ; bp - point to parm's
les bp,dword ptr [bp]+8 ; get address of p1
mov es:[bp],sp ; store sp in offset part
mov es:[bp]+2,ss ; store ss in segment part
mov ss,ax ; new stack segment from p2
mov sp,bx ; new stack pointer from p2
mov bp,sp ; re-establish bp for epilog
;
mov sp,bp ; Turbo Pascal generated epilog
pop bp ; - - - -
ret 8 ; - - - -
;
transfer endp
cseg ends
[ Listing 2a ]
procedure transfer(var p1,p2: process);
begin
inline(
$5D/ $C4/ $6E/ $04/ $26/ $8B/ $46/ $02/ $26/ $8B/ $5E/ $00/
$8B/ $EC/ $C4/ $6E/ $08/ $26/ $89/ $66/ $00/ $26/ $8C/ $56/
$02/ $8E/ $D0/ $8B/ $E3/ $8B/ $EC);
end;
[ Listing 2b ]
cseg segment 'cgroup'
assume cs:cseg
inthandler proc near
jmp start ; jump over data area
getbase:
call base ; subroutine to get base of data area.
base:
pop di ; pop address of base into di.
ret ; return with offset of base in di.
; data area:
newdsword dw ? ; data segment register for pascal
stkoffset dw ? ; offset of stack
stksegment dw ? ; segment of stack for pascal
procoffset dw ? ; offset of interrupt handler procedure
; segment of handler must be callsegment
calloffset dw ? ; offset of routine that makes short call
callsegment dw ? ; segment of routine that makes short call
savessword dw ? ; word to save ss into
savespword dw ? ; word to save sp into
newds equ newdsword-base ; offset from base to newdsword
newsp equ stkoffset-base ; offset from base to stkoffset
newss equ stksegment-base ; offset from base to stksegment
handler equ procoffset-base ; offset from base to procoffset
caller equ calloffset-base ; offset from base to calloffset
savess equ savessword-base ; offset from base to savessword
savesp equ savespword-base ; offset from base to savespword
start:
push di ; save di
call getbase ; get base of data area in di
mov word ptr cs:[di]+savess,ss ; save ss
mov word ptr cs:[di]+savesp,sp ; save sp
mov ss,word ptr cs:[di]+newss ; get new ss
mov sp,word ptr cs:[di]+newsp ; get new sp
push ax ; save the rest of the registers
push bx
push cx
push dx
push bp
push si
push es
push ds
mov ds,word ptr cs:[di]+newds ; get ds for pascal
mov bx,word ptr cs:[di]+handler ; get offset of handler
call dword ptr cs:[di]+caller ; long call to short caller
pop ds ; restore all registers
pop es ; and return from interrupt
pop si
pop bp
pop dx
pop cx
pop bx
pop ax
call getbase
mov ss,word ptr cs:[di]+savess
mov sp,word ptr cs:[di]+savesp
pop di
iret
inthandler endp
cseg ends
[ Listing 3 ]
cseg segment 'cgroup'
assume cs:cseg
shortcaller proc far
call bx
ret
shortcaller endp
cseg ends
[ Listing 4 ]
{ NAME: newioprocess
EXAMPLE CALL:
p:=NewIoProcess(Ofs(proc),1000);
proc is the parameterless procedure, from which
the new ioprocess is created. The stack of the
new ioprocess p is 1000 bytes.
}
function newioprocess(proc: integer; size: integer): ioprocess;
procedure shortcaller;
begin
inline($FF/$D3/$CB);
end;
const inthandler: array[1..85] of byte=
(
$EB, $16, $90, $E8, $00, $00, $5F, $C3, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$57, $E8, $E7, $FF, $2E, $8C, $55, $0E, $2E, $89, $65, $10,
$2E, $8E, $55, $06, $2E, $8B, $65, $04, $50, $53, $51, $52,
$55, $56, $06, $1E, $2E, $8E, $5D, $02, $2E, $8B, $5D, $08,
$2E, $FF, $5D, $0A, $1F, $07, $5E, $5D, $5A, $59, $5B, $58,
$E8, $B8, $FF, $2E, $8E, $55, $0E, $2E, $8B, $65, $10, $5F,
$CF);
var area: ^integer;
begin
GetMem(area,size+85);
Move(inthandler,area^,85);
memw[Seg(area^):Ofs(area^)+ 8]:=Dseg;
memw[Seg(area^):Ofs(area^)+10]:=Ofs(area^)+size+85;
memw[Seg(area^):Ofs(area^)+12]:=Seg(area^);
memw[Seg(area^):Ofs(area^)+14]:=proc;
memw[Seg(area^):Ofs(area^)+16]:=Ofs(shortcaller)+12;
memw[Seg(area^):Ofs(area^)+18]:=Cseg;
newioprocess:=area;
end;
[ Listing 5 ]
{ NAME: IoAttach
PARAMETERS:
`intnum' is an interrupt number
`proc' is an ioprocess created by newioprocess
}
procedure IoAttach(intnum: byte; proc: ioprocess);
var regs: record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer
end;
begin
with regs do
begin
ax:=$2500 + intnum; { DOS function 25H sets an }
ds:=Seg(proc^); { interrupt vector. }
dx:=Ofs(proc^);
end;
MsDos(regs); { request DOS function }
end;
[ Listing 6 ]
{$K-} { turn off checking for stack overflow }
program multitest;
type Process=^integer;
... { definitions of NewProcess & transfer }
var p1,p2: process;
procedure prog1;
begin
while true do
begin
writeln('Hi');
transfer(p1,p2);
writeln('He');
transfer(p1,p2);
end;
end;
procedure prog2;
begin
while true do
begin
writeln('Ho');
transfer(p2,p1);
end;
end;
var p0: process;
procedure main;
begin
p1:=newprocess(ofs(prog1),1000);
p2:=newprocess(ofs(prog2),1000);
transfer(p0,p1);
end;
begin main end.
[ Listing 7a ]
Resulting output:
Hi
Ho
He
Ho
Hi
Ho
.
.
.
[ Listing 7b ]
{$K-} { turn of checking for stack overflow }
program interrupttest;
type IoProcess = ^integer;
var count: integer;
var timerhandler: IoProcess;
... { definitions of NewIoProcess and IoAttach }
procedure incrementer;
begin
count:=succ(count);
end;
begin
timerhandler:=NewIoProcess(Ofs(incrementer),1000);
count:=0;
IoAttach($1C,timerhandler); { attach timerhandler to user }
while true do { timer interrupt ( 1Ch ) }
begin
writeln(count);
Delay(100); { delay 100 milliseconds }
end;
end.
[ Listing 8a ]
Resulting output:
0
1
3
5
7
8
10
12
.
.
.
[Listing 8b]